home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 034a / twview82.zip / PORTDISP.INC < prev    next >
Text File  |  1991-02-04  |  7KB  |  203 lines
  1. function compatible( i1, i2 : stuff; greed : boolean ) : boolean;
  2. { if each sells something the other buys; if greed is true, only org/equip
  3. trades. }
  4. begin
  5.   if i2 = -1 then
  6.     compatible := false
  7.   else if not greed then
  8.     case i1 of
  9.       Class0, 0, 7 : compatible := false;
  10.       1 : compatible := i2 in [2, 4, 6];
  11.       2 : compatible := i2 in [1, 4, 5];
  12.       3 : compatible := i2 in [4, 5, 6];
  13.       4 : compatible := i2 in [1, 2, 3];
  14.       5 : compatible := i2 in [2, 3, 6];
  15.       6 : compatible := i2 in [1, 3, 5];
  16.     end {case}
  17.   else
  18.     case i1 of
  19.       Class0, 0, 1, 6, 7 : compatible := false;
  20.       2, 3 : compatible := i2 in [4,5];
  21.       4, 5 : compatible := i2 in [2,3];
  22.     end; {case}
  23. end;
  24.  
  25. function deal( good1, good2 : stuff ) : string;
  26. { Port type "good1" selling to port type "good2" }
  27. const
  28.   ND = 'no deal';
  29.   F  = 'Fuel Ore';
  30.   O  = 'Organics';
  31.   Q  = 'Equipment';
  32.   any = 'anything';
  33.  
  34. begin
  35.   deal := ND;
  36.   case good1 of
  37.     Class0, 0 : ;  {error}
  38.         1 : if good2 in [0,2,4,6] then deal := F;
  39.         2 : if good2 in [0,1,4,5] then deal := O;
  40.         3 : if good2 in [0,4] then deal := O + ' or ' + F
  41.             else if good2 in [1,5] then deal := O
  42.             else if good2 in [2,6] then deal := F;
  43.         4 : if good2 in [0,1,2,3] then deal := Q;
  44.         5 : if good2 in [0,2] then deal := Q + ' or ' + F
  45.             else if good2 in [1,3] then deal := Q
  46.             else if good2 in [4,6] then deal := F;
  47.         6 : if good2 in [0,1] then deal := Q + ' or ' + O
  48.             else if good2 in [2,3] then deal := Q
  49.             else if good2 in [4,5] then deal := O;
  50.         7 : case good2 of
  51.                Class0,7 : ; {error}
  52.                0 : deal := any;
  53.                1 : deal := Q + ' or ' + O;
  54.                2 : deal := Q + 'or ' + F;
  55.                3 : deal := Q;
  56.                4 : deal := O + ' or ' + F;
  57.                5 : deal := O;
  58.                6 : deal := F;
  59.              end; {case 7}
  60.         end; {case}
  61. end; {deal}
  62.  
  63. function letterOfGood( g : goods ) : char;
  64. begin
  65.   case g of
  66.     fuel      : LetterOfGood := 'F';
  67.     Organics  : LetterOfGood := 'O';
  68.     Equipment : LetterOfGood := 'E';
  69.   end; {case}
  70. end; {letterOfGood}
  71.  
  72. procedure ComputeStores( psell, pbuy : PortIndex; var f : real;
  73.                          which : goods );
  74. var
  75.   level1, level2 : integer;                         
  76. begin
  77.   level1 := space.ports.data[ psell ].amts[ which ];
  78.   level2 := space.ports.data[ pbuy ].amts[ which ];
  79.   write( letterOfGood( which ), ':', level1, ' to ', level2, '  ' );
  80.   f := -minreal( -f, -minreal( level1, -level2 ) );
  81. end; {ComputeStores}
  82.                        
  83. procedure DisplayStores( psell, pbuy : PortIndex; s : string; 
  84.                         var f : real;
  85.                         EOonly : boolean );
  86. { we are given two ports, and a string s that represents the goods we are 
  87. going to be trading there.  For each good in s compute the minimum of
  88. the stores we have to sell and amount to purchase, and store the maximum in f,
  89. while also displaying the quantities the port holds. }
  90. begin
  91.   f := 0;
  92.   if not EOonly then
  93.     if pos( 'Fuel', s ) > 0 then
  94.       ComputeStores( psell, pbuy, f, Fuel );
  95.   if pos( 'Organic', s ) > 0 then
  96.     ComputeStores( psell, pbuy, f, Organics );
  97.   if pos( 'Equip', s ) > 0 then
  98.     ComputeStores( psell, pbuy, f, Equipment );
  99. end; {DisplayStores}
  100.  
  101. procedure PortTradeFactor( s1, s2 : sector; 
  102.                            items12, items21 : string; 
  103.                            EOonly : boolean );
  104. { Print port information from these two ports corresponding to trading
  105.   items from 1 to 2 and from 2 to 1; compute relative factor. }
  106. var
  107.   p1, p2 : PortIndex;
  108.   factor1, factor2 : real;
  109. begin
  110.   p1 := PortNumber( s1 );
  111.   p2 := PortNumber( s2 );
  112.   if p1 = 0 then
  113.     writeln('No info available for ', s1 )
  114.   else if p2 = 0 then
  115.     writeln('No info available for ', s2 )
  116.   else
  117.     begin
  118.       write('Quantities: ');
  119.       DisplayStores( p1, p2, items12, factor1, EOonly);
  120.       DisplayStores( p2, p1, items21, factor2, EOonly);
  121.       writeln(' Factor: ', round( sqrt( factor1 * factor2 ) ) );
  122.     end; {else}
  123. end; {PortTradeFactor}
  124.  
  125. procedure SearchPairs( NumPorts : integer;
  126.                        logging : boolean; var h : text;
  127.                        asciiDump : boolean; var f : text;
  128.                        EquipOnly, ShowLevels : boolean );
  129. var
  130.   i         : integer;
  131.   s, s1     : sector;
  132.   g, g1     : stuff;
  133.   t         : warpIndex;
  134.   NumPairs  : integer;
  135.   PauseAt   : integer;
  136.  
  137. begin
  138.   NumPairs := 0;
  139.   if ShowLevels then
  140.     PauseAt := 10
  141.   else
  142.     PauseAt := 20;
  143.   for i := 1 to NumPorts do
  144.     if space.sectors[ distances[i].s ].portType <> NotAPort then
  145.       begin
  146.         s := distances[ i ].s;
  147.         if space.sectors[s].number <> Unexplored then
  148.          for t := 1 to space.sectors[s].number do
  149.           begin
  150.             s1 := space.sectors[s].data[t];
  151.             if  (space.sectors[ s1].portType <> NotAPort )
  152.                 and (s < s1) and IsWarp( s1, s) then
  153.                 { must be a port; print only once; check if can get back }
  154.               if compatible( space.sectors[s].portType, space.sectors[s1].portType, EquipOnly ) then
  155.                 begin
  156.                   if logging then
  157.                     begin
  158.                       writeln( h, 'R', s );
  159.                       writeln( h, 'R', s1);
  160.                     end; {log}
  161.                   g := space.sectors[s].portType;
  162.                   g1 := space.sectors[s1].portType;
  163.                   writeln('( ', s:3,' & ', s1:3, ' ) at distance ',
  164.                            distances[i].d, ' trading ', deal( g, g1), ' for '
  165.                            , deal( g1, g ));
  166.                   if ShowLevels then
  167.                     PortTradeFactor( s, s1, deal( g, g1), deal( g1, g ), EquipOnly );
  168.                   if AsciiDump then
  169.                     writeln(f, '( ', s:3,' & ', s1:3, ' ) at distance ',
  170.                              distances[i].d, ' trading ', deal( g, g1), ' for '
  171.                              , deal( g1, g ));
  172.                   NumPairs := NumPairs + 1;
  173.                   if numPairs mod PauseAt = 0 then
  174.                     if not prompt('more? ') then
  175.                       exit;
  176.                 end; {if if}
  177.           end; {for t}
  178.       end; {if}
  179. end; {SearchPairs}
  180.  
  181. procedure pairport;
  182. var
  183.   QuantInfo,
  184.   Greedy   : boolean;
  185.   NumPorts : integer;
  186.   AsciiDump,
  187.   loggit   : boolean;
  188.   h, fp    : text;
  189. begin
  190.   SortPorts( NumPorts );
  191.   QuantInfo := prompt('Do you want to see port quantity information? ');
  192.   greedy := prompt('Do you want to only see Equip/Organic trades? ');
  193.   loggit := LogToDisk( h,
  194.         'Do you want to log the results in a format suitable for upload? ' );
  195.   AsciiDump := LogToDisk( fp,
  196.         'Do you want an echo of the results to an ascii file? ');
  197.   SearchPairs( NumPorts, Loggit, h, AsciiDump, fp, greedy, QuantInfo );
  198.   if loggit then
  199.     close( h );
  200.   if AsciiDump then
  201.     close( fp );
  202. end; {pair ports}
  203.